perm filename MAKE.SAI[4,ALS]1 blob
sn#052865 filedate 1973-07-09 generic text, type T, neo UTF8
00010 BEGIN "MAKE"
00020
00025 DEFINE ⊂="COMMENT";
00027 DEFINE TB="'11";
00028 DEFINE INSIZ="24";
00030 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00040 INTEGER I,J,K,L,Q,P,CHAN1,CHAN2,CHAN3,CHAN4,EOF,HPOINT;
00045 INTEGER HPNT1,HPNT2,HPNT3,HPNT4;
00050 STRING READ1,READ2,READ3,READ4,READ5;
00055 INTEGER ARRAY INSAVE[0:4];
00060
00080
00090 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4;
00100 HEADIN; ⊂ Bring in header information;
00120 OUTSTR(CRLF&"This routine is used to generate SIGNATURE TABLES."&CRLF);
00130 OUTSTR("It will ask a number of questions which must be answered by"&CRLF
00140 &" typing the required information followed by a CR."&CRLF);
00150
00160 OUTSTR("PH list and H list table contains"&CRLF);
00170 OUTSTR(CRLF&"PH"&TB&"Significant features"&CRLF);
00180 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00190 IF PHLIST[I]=0 THEN DONE;
00200 OUTSTR(CVXSTR(PHLIST[I])&TB);
00210 HPOINT←POINT(1,HLIST[I],-1);
00220 FOR J←0 STEP 1 UNTIL 35 DO
00230 IF (K←ILDB(HPOINT))=1 THEN OUTSTR(CVXSTR(FLIST[J])&" ");
00240 OUTSTR(CRLF);
00250 END;
00260
00270 OUTSTR("Enter corrections or additions. Type PH symbol followed by features. "&CRLF);
00280 OUTSTR("After each CR you will be prompted as to what is expected next."&CRLF);
00290 K←0;
00300 WHILE J≥0 DO BEGIN
00310 IF (READ1←STRIN("PH symbol = ")) ="" THEN DONE;
00320 K←K+1;
00330 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00340 IF PHLIST[I]=0 THEN PHLIST[I]←CVSIX(READ1);
00350 IF CVSIX(READ1)=PHLIST[I] THEN DONE;
00360 END;
00370 HLIST[I]←0;
00380 WHILE J≥0 DO BEGIN
00390 WHILE J≥0 DO BEGIN
00400 IF (READ2←STRIN("F="))="" THEN DONE;
00410 HPOINT←POINT(1,HLIST[I],-1);
00420 FOR J←0 STEP 1 UNTIL 35 DO BEGIN
00430 IBP(HPOINT);
00440 IF FLIST[J]=0 THEN BEGIN FLIST[J]←CVSIX(READ2);
00450 OUTSTR(READ2&" added to feature list"&CRLF); END;
00460 IF CVSIX(READ2)=FLIST[J] THEN DONE;
00470 END;
00480 IF J≥36 THEN OUTSTR("NOT FOUND"&CRLF) ELSE DONE;
00490 END;
00500 IF READ2 ="" THEN DONE;
00510 DPB(1,HPOINT);
00520 END;
00530 CLRBUF;
00540 END;
00550 OUTSTR(CRLF);
00560 IF K≠0 THEN BEGIN
00570 OUTSTR("PH list and H list table now contains"&CRLF);
00580 OUTSTR(CRLF&"PH"&TB&"Significant features"&CRLF);
00590 FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00600 IF PHLIST[I]=0 THEN DONE;
00610 OUTSTR(CVXSTR(PHLIST[I])&TB);
00620 HPOINT←POINT(1,HLIST[I],-1);
00630 FOR J←0 STEP 1 UNTIL 35 DO
00640 IF (K←ILDB(HPOINT))=1 THEN OUTSTR(CVXSTR(FLIST[J])&" ");
00650 OUTSTR(CRLF);
00660 END;
00670 OUTSTR(CRLF);
00680 END;
00010 IF (STRIN("Do you want to start fresh from here on YorCR = "))="Y" THEN
00020 FOR I←0 STEP 1 UNTIL TABNUM-1 DO BEGIN
00025 NAMES[I]←PARENT[I]←LRN1[I]←LRN2[I]←LRN3[I]←LRN4[I]←0;
00027 IN1[I]←IN2[I]←IN3[I]←IN4[I]←OUT1[I]←OUT2[I]←OUT3[I]←OUT4[I]←0; END;
00030
00040 WHILE TRUE DO BEGIN "OVERAL"
00050 IF NAMES[0]=0 THEN OUTSTR("All tables have been zeroed"&crlf) else begin
00060
00070 OUTSTR(CRLF&"The following tables exist"&CRLF);
00080 OUTSTR("Name"&TB&"Parent"&TB&"OUT1"&TB&"OUT2"&TB&"OUT3"&TB&"OUT4"&TB&
00090 "IN1"&TB&"IN2"&TB&"IN3"&TB&"IN4"&CRLF);
00100 FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
00110 IF NAMES[I]=0 THEN DONE;
00120 J←(IN1[I] LAND '77);K←(IN2[I] LAND '77);
00130 IF (IN3[I]=0) THEN READ1←" "
00135 ELSE READ1←CVXSTR(INNAM[IN3[I] LAND '77]);
00137 IF (IN4[I]=0) THEN READ2←" " ELSE
00138 READ2←CVXSTR(INNAM[IN4[I] LAND '77]);
00140 OUTSTR(CVXSTR(NAMES[I])&TB&CVXSTR(PARENN[I])&TB&
00145 CVXSTR(OUT1[I])&TB&CVXSTR(OUT2[I])&TB&CVXSTR(OUT3[I])&TB&CVXSTR(OUT4[I])
00150 &TB&CVXSTR(INNAM[J])&TB&CVXSTR(INNAM[K])&TB
00155 &READ1&TB&READ2&CRLF); END; END;
00160
00170 CLRBUF;
00180
00190 WHILE TRUE DO BEGIN "OUTSID"
00200
00210 WHILE TRUE DO BEGIN "GETNAM"
00220 OUTSTR(CRLF&"Now type the name of a table to be modified or added."&CRLF);
00230 IF (READ1←STRIN("A CR. only, terminates the session. Name= "))="" THEN DONE;
00240 J←CVSIX(READ1);
00250 FOR I←0 STEP 1 UNTIL TABNUM DO IF NAMES[I]=J THEN DONE ELSE
00260 IF NAMES[I]=0 THEN DONE;
00270 IF NAMES[I]=J THEN DONE; CLRBUF;
00280 IF (READ2←STRIN("Is this a new table = "))="N" then
00290 OUTSTR("Try again"&CRLF) ELSE BEGIN NAMES[I]←J; DONE END; END "GETNAM";
00300 IF READ1="" THEN DONE;
00310
00320 WHILE TRUE DO BEGIN "PARENT" ⊂ SIG uses index 13 for start of OUTPUTS array;
00330 READ2←STRIN("Type name of parent (same name used for gating)= ");
00340 PARENN[I]←K←CVSIX(READ2);
00350 IF READ2="" THEN DONE;
00360 FOR J←0 STEP 1 UNTIL TABNUM DO IF K=OUT1[J] THEN DONE;
00370 IF J≤TABNUM THEN BEGIN
00380 PARENT[I]←'330613000000+J; DONE END ELSE
00390 FOR J←0 STEP 1 UNTIL TABNUM DO IF K=OUT2[J] THEN DONE;
00400 IF J≤TABNUM THEN BEGIN
00410 PARENT[I]←'220613000000+J; DONE END ELSE
00420 FOR J←0 STEP 1 UNTIL TABNUM DO IF K=OUT3[J] THEN DONE;
00430 IF J≤TABNUM THEN BEGIN
00440 PARENT[I]←'110613000000+J; DONE END ELSE
00450 FOR J←0 STEP 1 UNTIL TABNUM DO IF K=OUT4[J] THEN DONE;
00460 IF J≤TABNUM THEN BEGIN
00470 PARENT[I]←'000613000000+J; DONE END;
00480 OUTSTR("Name not found. "); END "PARENT";
00490
00500 OUTSTR("Up to 4 output names may be specified (Ph or Feature)"&CRLF);
00510 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "OUTPUT"
00520 WHILE TRUE DO BEGIN
00530 IF (READ4←STRIN("Type output name ="))="" THEN DONE;
00540 IF L≤3 THEN OUT4[I]←0; IF L≤2 THEN OUT3[I]←0; IF L=0 THEN OUT2[I]←0;
00550 K←CVSIX(READ4);
00560 FOR J←0 STEP 1 UNTIL 63 DO IF K=PHLIST[J] THEN DONE;
00570 IF J≤63 THEN BEGIN
00580 IF L=0 THEN BEGIN OUT1[I]←K; LRN1[I]←0; END ELSE
00590 IF L=1 THEN BEGIN OUT2[I]←K; LRN2[I]←0; END ELSE
00600 IF L=2 THEN BEGIN OUT3[I]←K; LRN3[I]←0; END ELSE
00610 IF L=3 THEN BEGIN OUT4[I]←K; LRN4[I]←0; END;
00620 DONE END;
00621 IF J≥64 THEN BEGIN
00622 HPNT1←POINT(1,LRN1[I],-1);
00623 HPNT2←POINT(1,LRN2[I],-1);
00624 HPNT3←POINT(1,LRN3[I],-1);
00625 HPNT4←POINT(1,LRN4[I],-1);
00631 FOR J←0 STEP 1 UNTIL 35 DO BEGIN
00632 IF L=0 THEN IBP(HPNT1); IF L=1 THEN IBP(HPNT2);
00633 IF L=2 THEN IBP(HPNT3); IF L=3 THEN IBP(HPNT4);
00634 IF K=FLIST[J] THEN DONE; END; END;
00640 IF J≤35 THEN BEGIN
00650 IF L=0 THEN BEGIN OUT1[I]←K; DPB(1,HPNT1); END ELSE
00660 IF L=1 THEN BEGIN OUT2[I]←K; DPB(1,HPNT2); END ELSE
00670 IF L=2 THEN BEGIN OUT3[I]←K; DPB(1,HPNT3); END ELSE
00680 IF L=3 THEN BEGIN OUT4[I]←K; DPB(1,HPNT4); END;
00690 DONE END;
00700 OUTSTR("Output name not found. "); END;
00710 IF READ4="" THEN DONE END "OUTPUT";
00720
00730 OUTSTR("2, 3 or 4 inputs may be specified"&CRLF);
00740 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "INPUTS"
00750 WHILE TRUE DO BEGIN
00760 IF (READ3←STRIN("Type INPUT NAME ="))="" THEN
00770 IF L>1 THEN DONE;
00780 K←CVSIX(READ3);
00790 FOR J←0 STEP 1 UNTIL INSIZ-1 DO IF K=INNAM[J] THEN DONE;
00800 IF J=INSIZ THEN OUTSTR("Input name not found. ") ELSE DONE;
00810 END; IF READ3="" THEN DONE; INSAVE[L]←J;
00820 END "INPUTS";
00830
00840
00850 IF L=2 THEN BEGIN ⊂ SIG uses index 7 for start of INDAT array;
00860 IN1[I]←'020407000000+INSAVE[0];
00870 IN2[I]←'020407000000+INSAVE[1]; IN3[I]←IN4[I]←0; END;
00880
00890 IF L=3 THEN BEGIN
00900 IN1[I]←'030307000000+INSAVE[0];
00910 IN2[I]←'030307000000+INSAVE[1];
00920 IN3[I]←'040207000000+INSAVE[2]; IN4[I]←0; END;
00930
00940 IF L=4 THEN BEGIN
00950 IN1[I]←'040207000000+INSAVE[0];
00960 IN2[I]←'040207000000+INSAVE[1];
00970 IN3[I]←'040207000000+INSAVE[2];
00980 IN4[I]←'040207000000+INSAVE[3]; END;
00990 END "OUTSID";
00030 CHAN1←GETCHAN;
00040 CLOSE(CHAN1);
00050 OPEN(CHAN1,"DSK",'10,0,10,0,0,EOF);
00060 ENTER(CHAN1,"TABHED.DAT",0);
00070 ARRYOUT(CHAN1,INNAM[0],INSIZ);
00080 ARRYOUT(CHAN1,FLIST[0],36);
00090 ARRYOUT(CHAN1,PHLIST[0],64);
00100 ARRYOUT(CHAN1,HLIST[0],64);
00110 ARRYOUT(CHAN1,NAMES[0],TABNUM);
00120 ARRYOUT(CHAN1,PARENT[0],TABNUM);
00125 ARRYOUT(CHAN1,PARENN[0],TABNUM);
00130 ARRYOUT(CHAN1,GATE[0],TABNUM);
00140 ARRYOUT(CHAN1,IN1[0],TABNUM);
00150 ARRYOUT(CHAN1,IN2[0],TABNUM);
00160 ARRYOUT(CHAN1,IN3[0],TABNUM);
00170 ARRYOUT(CHAN1,IN4[0],TABNUM);
00175 ARRYOUT(CHAN1,OUT1[0],TABNUM);
00180 ARRYOUT(CHAN1,OUT2[0],TABNUM);
00190 ARRYOUT(CHAN1,OUT3[0],TABNUM);
00200 ARRYOUT(CHAN1,OUT4[0],TABNUM);
00202 ARRYOUT(CHAN1,LRN1[0],TABNUM);
00204 ARRYOUT(CHAN1,LRN2[0],TABNUM);
00206 ARRYOUT(CHAN1,LRN3[0],TABNUM);
00208 ARRYOUT(CHAN1,LRN4[0],TABNUM);
00210 ARRYOUT(CHAN1,OUTPUT[0],TABNUM);
00230
00240 CLOSE(CHAN1);
00250 RELEASE(CHAN1);
00252 IF (READ1←STRIN("Do you want to review tables "))≠"Y" THEN
00254 DONE ; END "OVERAL";
00257
00260 END "MAKE";